(include "compiler/desugar.scm")
(include "compiler/hoist.scm")
(include "compiler/denest.scm")
(include "compiler/tmp-alloc.scm")
(include "compiler/flatten.scm")
(include "compiler/assembler.scm")

(define (pretty-print x) (print x))

(define (print0 port)
  (if port
      (lambda (n)
	(display:port n port)
	(display:port (integer->char 0) port))
      (lambda (n)
	(display n)
	(display (integer->char 0)))))

;(define debug #f)


(define (load-macros)
(let ((xmacros (read-file "compiler/mac/macros.scm")))
(for-each load-macro xmacros)))

(define (compile filename debug port halt)
  (let* ((__ (when debug (print 'reading-file)))
	 (stdlib (read-file "standard-functions.scm"))
	 (__ (when debug (newline)))
	
	 (__ (when debug (print 'pass:desugar)))
	 (toplevel-info (make-stack stdlib))
	 (defs (desugar-top filename "" toplevel-info))
	 (__ (when debug (pretty-print (stack-top toplevel-info))))
	 (__ (when debug (pretty-print defs)))
	 (__ (when debug (newline)))
	
	 (__ (when debug (print 'pass:hoist)))
	 (code (empty-queue))
	 (clos (empty-stack))
	 (__ (mapply hoist-top defs code clos (stack-get toplevel-info)))
	 (__ (when debug (pretty-print (queue:top code))))
	 (__ (when debug (pretty-print clos)))
	 (__ (when debug (newline)))
	
	 (__ (when debug (print 'pass:denest)))
	 (code (mapply denest-top (queue:top code)))
	 (clos (mapply denest-top (stack-get clos)))
	 (__ (when debug (pretty-print code)))
	 (__ (when debug (pretty-print clos)))
	 (__ (when debug (newline)))
	
	 (__ (when debug (print 'pass:tmp-alloc)))
	 (code (mapply tmp-alloc-top code))
	 (clos (mapply tmp-alloc-top clos))
	 (__ (when debug (pretty-print code)))
	 (__ (when debug (pretty-print clos)))
	 (__ (when debug (newline)))
	
	 (__ (when debug (print 'pass:flatten)))
	 (code (flatten-program code clos halt))
	 (__ (when debug (pretty-print code)))
	 (__ (when debug (newline)))
	 
	 (__ (when debug (print 'pass:assemble)))
	 (code (assemble code))
	 (__ (when debug (pretty-print code)))
	 (__ (when debug (newline)))
	 )
    
;    (when debug
;      (print 'compiling-done)
;      (print 'toplevel-info)
;      (for-each pretty-print (stack-get toplevel-info))
;      (newline)
;      (newline)
;      (print 'compiled-code)
;      (pretty-print code)
;      (newline))
 
    (for-each (print0 port) code)
 
    (when debug
      (newline))))

;(define (main)
;  (let ((args (command-line-arguments)))
;    (let ((filename (case (length args)
;		      ((1) (car args))
;		      ((2) (case (car args)
;			     (("-d") (set! debug #t))
;			     (else (error 'main "unknown flag")))
;		       (cadr args))
;		      (else (error 'main "args")))))
;      (parameterize ((print-gensym 'pretty/suffix))
;	(compile filename)))))


;; commented out for CHEZ

(define (compile-stdin)
  (compile (car (read-port standard-input)) ;(current-input-port)
	   #f
	   #f
	   '(halt)))

(define (compile-and-run-file filename)
  (for-each eval `((include ,filename))))

(define (debug-build-file filename)
  (compile `(include ,filename) #t #f '(halt)))
